perm filename PARTS.F4[MSS,LCS] blob sn#237516 filedate 1976-09-19 generic text, type T, neo UTF8
00100	C THIS AIDS IN EXTRACTING PARTS FROM SCORES. SEE PT1.CMD
00200		COMMON/STF/RSTFAC(-3/4),RSTJ2 /POSI/STFF(-3/4),JJ2,JPQ
00300		1 /IVV/IWDS(200)
00400		COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00500	C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00600		COMMON/XRN/RN(4000) /SF/KL,RT,KP,STFSZ,NAMX
00700		1 /PTR/PWDS(700)/LLL/L,LL,I,IX/XXX/LK,LP,JY
00800	C  INCREASE DIMENSION OF PWDS FOR VERY FULL PAGES.
00900	      DIMENSION KNM(10),NRD(100),MM(4000),NN(4000),
01000		1 KWDS(1),KPN(1)
01100		COMMON /PX/PN(1800) /Q/Q(8200)
01200		COMMON /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01300		DATA FIB/.7/,RSPC/24./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01400		1 ,RLTRSZ/1.0/,SPCNT/0.7/
01500		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
01600		1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT)
01700		1,(MM,RN),(NN,RN(4001)),(KWDS,PWDS),(KPN,PN)
01800	C  RQ(2) IS R4, RQ(3) IS R5 ETC.
01900	
01950		IPG=0
02000		JNM=1
02100		MRD=0
02200		JRD=0
02300	
02400		TYPE 3
02500		ACCEPT 2,RS,NTYPE
02600	C  TYPE ANY NUM AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
02700		IF(RS.EQ.' ')RS='OLD'
02800		IF(RS.EQ.'OLD')CALL PT2
02900		CALL IFILE(1,RS)
03000	244	FORMAT(I,A5,30I)
03100	544	READ(1,244,END=344),K,KNM(JNM),(IWDS(K),K=1,30)
03200		JNM=JNM+1
03300		DO 444 K=1,30
03400		J=IWDS(K)
03500		JRD=JRD+1
03600		NRD(JRD)=J
03700	444	IF(J.EQ.0)GO TO 544
03800	
03900	344	KNM(JNM)='ZZZZZ'
04000		JNM=1
04100		JRD=0
04200	744	XSIG=FIB
04300		CLEF=-1
04400		XMTR=FIB
04500		XLFT=0
04600		ENDLN=0
04700		KQ=0
04800		YCLEF=2.
04900		YSIG=2.
05000		YMTR=2.
05100		KW=1
05200		KX=1
05300		RSTAFF=0
05400		RM=0
05500		L=1
05600		LK=1
05700	CC	IF(LSTNM.NE.0)GO TO 87
05800	CC10	IF(LSTNM.EQ.0)GO TO 83
05900	CC87	IF(NAME.GE.LSTNM)GO TO 83
06000	CC	NAME=NAME+2
06100	CC	GO TO 84
06200	86	FORMAT(1XA5)
06300	3	FORMAT(' TYPE FILE NAME  ',$)
06400	CC300	FORMAT(' TYPE FINAL NAME  ',$)
06500	CC83	IF(JRD.EQ.0)GO TO 183
06600	
06700	83	NAME=KNM(JNM)
06800		JNM=JNM+1
06900		IF(NAME.EQ.'ZZZZZ')GO TO 20
07000		JREAD=-1
07100		JRD=JRD+1
07200		NXX=NRD(JRD)
07300		NAMZ=NAME
07400		GO TO 284
07500	
07600	CC	LSTNM=KNM(JNM)-2
07700	C  ALL DONE  ↑↑
07800	CC	GO TO 283
07900	CC183	TYPE 3
08000	CC	ACCEPT 2,NAME
08100	CC	IF(NAME.EQ.' ')GO TO 83
08200	CC	IF(NAME.EQ.'X')GO TO 20
08300	CC	TYPE 300
08400	CC	ACCEPT 2,LSTNM
08500	CC	IF(LSTNM.EQ.' ')LSTNM=NAME
08600	CC	IF(LSTNM.EQ.' ')GO TO 83
08700	CC283	NAMZ=NAME
08800	
08900	10	IF(LOOKF(NAME))GO TO 284
09000		NAME=NAMZ+256
09100		IF(LOOKF(NAME).GE.0)GO TO 83
09200		NAMZ=NAME
09300	C  FOUND NO MORE TO READ
09400	284	JZ=0
09500		SN=200
09600		SNMTR=SN
09700		IF(RM.NE.0)GO TO 277
09800		RM=-1
09900	4	FORMAT(' TYPE INST NAME  '$)
10000		TYPE 4
10100		ACCEPT 2,RNAM,K
10200		RNAM2=0
10300		RNAM3=0
10400		RNAM4=0
10500		IF(K.EQ.0)GO TO 277
10600		TYPE 177
10700		ACCEPT 2,RNAM2,K
10800		IF(K.EQ.0)GO TO 277
10900	C  TYPE NUM AFTER NAME TO ENTER UP TO 4 NAMES.
11000		TYPE 177
11100		ACCEPT 2,RNAM3
11200		TYPE 177
11300		ACCEPT 2,RNAM4
11400	177	FORMAT(' OTHER INST NAME   ',$)
11500	
11600	CC	IF(INM.EQ.'99')GO TO 20
11700	CC	K=SN/100.
11800	CC77	TYPE 86,NAME
11900	CC	IF(JRD.EQ.0)GO TO 777
12000	C  FOR COMMAND FILE
12100	CC	N=NRD(JRD)
12200	CC	N=N-1
12300	CC	NRD(JRD)=N
12400	CC	IF(N.GT.0)GO TO 277
12500	CC	IF(NRD(JRD+1))LSTNM=NAME
12600	CC	IF(N.EQ.0)GO TO 277
12700	CC	JRD=JRD+1
12800	CC	IF(N.EQ.-1)GO TO 43
12900	CC	GO TO 83
13000	CC777	IF(KW.EQ.1)GO TO 277
13100	CC	TYPE 577
13200	CC	ACCEPT 2,PG
13300	CC	IF(PG.EQ.'N')GO TO 43
13400	CC577	FORMAT(' N=NEW BRACE OR <CR> ',$)
13500	CC277	REWIND 21
13600	
13700	277	TYPE 86,NAME
13800		CALL GETFIL(NAME)
13900	CC	CALL IFILE(21,NAME)
14000	C  LP IS START OF RN ARRAY THIS TIME
14100		CALL FASTIN(RSTFAC,20)
14200		CALL FASTIN(PWDS(KW),JJ2)
14300		CALL FASTIN(RN(KX),JPQ)
14400	CC	IF(JREAD)GO TO 477
14500	C  SKIP FIRST TIME FOR THIS PAGE
14600		LA=KX-1
14700		P=0
14800		DO 577 K=KW,KW+JJ2-3
14900		J=KWDS(K)+LA
15000		R=RN(J+1)
15100		IF(R.NE.8)GO TO 677
15200		IF(RN(J).LT.6)GO TO 577
15300	C  NO NAME ON THIS STAFF - SO JUMP
15400		IF(RN(J+7).NE.0)GO TO 577
15500	C  SKIPS INVISIBLE STAVES.
15600		XLFT=RN(J+3) 
15700	C LEFT LIMIT OF STAFF
15800		R9=RN(J+9)
15900		IF(NTYPE.NE.0)TYPE 86,R9
16000		IF(R9.EQ.RNAM)GO TO 977
16100		IF(RNAM2.EQ.R9)GO TO 977
16200		IF(RNAM3.EQ.R9)GO TO 977
16300		IF(RNAM4.NE.R9)GO TO 577
16400	977	SN=RN(J+2)+RSTAFF
16500		SNMTR=SN
16600		GO TO 477
16700	677	IF(R.NE.10)GO TO 79
16800		IF(RN(J).LT.4)GO TO 79
16900		IF(RN(J+6).GT.RNUM)GO TO 79
17000	C  SKIPS PAGE NUMS. (I.E. BIG SIZE)
17100		IF(RN(J).GE.6)P=-1
17200	C  FOUND A NUM. IN BOX ↑↑, REMEMBER IT DID.
17300		GO TO 577
17400	79	IF(R.NE.16)GO TO 577
17500		IF(RN(J+5).GE.100)P=-1
17600	C  PICKS UP WORD WITH SZ >100
17700	577	CONTINUE
17800	C  DIDN'T FIND USEFUL INFO SO SKIP THIS FILE
17900		IF(JREAD.OR.P)GO TO 477
18000	C  ALWAYS USE THE FIRST FILE READ AND FILES WITH REHRSL NUMS.
18100		KWDS(KW)=LA
18200		GO TO 877
18300	
18400	CC	READ(21),ITEM,I,
18500	CC	1 (PWDS(K),K=KW,ITEM+KW),(RN(K),K=KX,I+KX-2),ISCR,(IV(K),K=1,ISCR),
18600	CC	1 LCNT,(IV(K),K=1,LCNT),RSTFAC,STFF
18700	
18800	477	I=JPQ-2
18900	C READS AND WRITES 1 EXTRA WORD
19000		ITEM=JJ2+KW-3
19100	CC	ITEM=ITEM+KW-1
19200		JREAD=0
19300		IF(KW.NE.1)CALL LOOP1
19400		RSTAFF=RSTAFF+8
19500	
19600	CC	IF(KW.EQ.1)GO TO 377
19700	CC	DO 477 K=KW,ITEM+1
19800	CC	PWDS(K)=PWDS(K)+R
19900	CC	LA=PWDS(K)+2
20000	CC477	RN(LA)=RN(LA)+RSTAFF
20100	C  FOR COMBINED FILES
20200	377	KW=ITEM+1
20300	
20400	CC	R=PWDS(KW)-1
20500		KK=JPQ
20600	CC	KX=KX+I-1
20700		KX=KX+JPQ
20800	
20900	CC	NAME=NAME+2
21000	CC	IF(NAME.GT.LSTNM)GO TO 44
21100	CC	IF(LOOKF(NAME))GO TO 257
21200	CC43	NAME=NAME-2
21300	
21400	877	NXX=NXX-1
21500		NAME=NAME+2
21600		IF(NXX.NE.0)GO TO 277
21700		JRD=JRD+1
21800		NXX=NRD(JRD)
21900		IF(NXX.NE.0)GO TO 44
22000		NAME=0
22100		NAMZ=0
22200	44	KX=1
22300		JREAD=-1
22400		RSTAFF=0
22500		KW=1
22600	13	IWDS(1)=1
22700		YN=0
22800		IF(SN.NE.200)GO TO 8
22900		YN=-1
23000		IF(YCLEF.GT.1)YCLEF=-1
23100		IF(YSIG.GT.1)YSIG=-1
23200		IF(YMTR.GT.1)YMTR=-1
23300	
23400	8	ZLFT=XLFT+.5
23500		RNUM=PGNUM
23600	C  SIZE FACTOR FOR PAGE NUMBER FINDER (MAYBE).
23700	
23800		DO 6 K=1,ITEM
23900		R5=-1
24000		J=KWDS(K)
24100		R=RN(J+1)
24200		IF(R.NE.10)GO TO 800
24300		IF(RN(J).LT.4)GO TO 80
24400		IF(RN(J+6).GT.RNUM)GO TO 6
24500	C  SKIPS PAGE NUMS. (I.E. BIG SIZE)
24600		IF(RN(J).LT.6)GO TO 80
24700	C  FOUND A NUM. IN BOX ↓↓
24800		RN(J+6)=RNMSZ
24900		RN(J+4)=RNMHT
25000	C  THE ABOVE SET HEIGHT AND SIZE OF REHEARSAL NUMS.
25100	CC2182	RN(J+2)=SN
25200	CC	IF(YN.EQ.'Y')RPOS=RN(J+3)-3.
25300		GO TO 810
25400	800	IF(R.NE.4)GO TO 80
25500	CCC	IF(NBAR)GO TO 80
25600		IF(RN(J).NE.2)GO TO 182
25700	C  FOUND A BAR LINE
25800		IF(RN(J+3).LT.ZLFT)GO TO 6
25900	C DROPS BAR LINE AT LEFT OF STAFF.
26000	CC	KZ=RN(J+4)/100.
26100	CC	RN(J+4)=1.+KZ*100.
26200	C  KZ IS FOR THICK BARS.
26300	CC	RR=RN(J+3)
26400	CC	DO 82 KY=K+1,ITEM
26500	CC	KZ=PWDS(KY)
26600	CC	IF(RN(KZ+1).NE.4)GO TO 82
26700	CC	IF(RN(KZ).NE.2)GO TO 82
26800	C  AVOIDS DUPLICATE BARS.
26900	CC	IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82CC	
27000	CC	RN(KZ+2)=99
27100	CC	RN(KZ+1)=0
27200	CC82	CONTINUE
27300		CALL DBAR(K,ITEM,J)
27400		IF(YN.EQ.0)GO TO 810
27500	CC	CALL ADDRST(RR,XWDS,PN)
27600		CALL ADRST(IWDS)
27700		GO TO 6
27800	182	RN(J+1)=44
27900	C  CHANGES CODE NUM 
28000		IF(RN(J).LT.5)GO TO 80
28100		IF(RN(J+7).GE.3)GO TO 6
28200	C  SKIP HEAVY BRACKETS.
28300	80	IF(R.NE.16)GO TO 180
28400		IF(RN(J+5).GE.100)RN(J+2)=SN
28500	C CATCHES WANTED TEXT ON OTHER LINES.  (P5>100)
28600		IF(RN(J+5).GT.RLTRSZ)RN(J+5)=RLTRSZ
28700	C  LIMITS SIZE OF LETTERS.  ADJUST RLTRSZ TO SUIT. (SET AT 1.0 NOW)
28800	180	RSN=RN(J+2)
28900	C  THE STAFF NUM.
29000		IF(R.NE.3)GO TO 3801
29100		IF(YCLEF)GO TO 4801
29200		IF(RSN.NE.SN)GO TO 6
29300	4801	RR=AMOD(RN(J+5),100.0)
29400	C    ↑↑↑↑↑ BECAUSE SOME CLEFS ARE MINI-CLEFS
29500		IF(RN(J).LT.3)RR=0
29600		IF(RR.EQ.CLEF)GO TO 6
29700	C SKIP DUPLICATE CLEFS.
29800		IF(RR.GT.3.AND.RR.LT.100)GO TO 4800
29900	C  CATCHES CLEFS (≤3) OR MINI-CLEFS (>3)
30000		IF(YCLEF.GE.0)GO TO 17
30100		TYPE 16,RR
30200	16	FORMAT(' CLEF=',F2.0,' --CHANGE TO--',$)
30300		ACCEPT 5,RR
30400		R5=RR
30500	17	CLEF=RR
30600	C**	IF(YCLEF.EQ.1)GO TO 4802
30700	C**	IF(YCLEF)YCLEF=1.
30800		YCLEF=0
30900		GO TO 1800
31000	4800	IF(RSN.NE.SN)GO TO 6
31100		RN(J+1)=33
31200		GO TO 1800
31300	4802	YCLEF=0
31400	C  CATCHES CLEF AFTER FIRST RESTS.
31500		GO TO 6
31600	3801	IF(R.NE.17)GO TO 3800
31700		IF(YSIG)GO TO 3802
31800		IF(RSN.NE.SN)GO TO 6
31900	3802	RR=RN(J+5)
32000		IF(RR.EQ.XSIG)GO TO 6
32100		YSIG=0
32200		XSIG=RR
32300	C SKIPS DUPL. KEY SIGS.
32400		GO TO 1800
32500	3800	IF(R.EQ.8)GO TO 6
32600	C  OMIT ALL STAVES FOR NOW
32700		IF(R.NE.18.)GO TO 81
32800		IF(YMTR)GO TO 1801
32900		IF(SNMTR.EQ.200.)SNMTR=RSN
33000	C  SO IT WON'T REPEAT METERS.
33100	C  CHECK ALL METERS IF LINE HAS NOT THIS INST.
33200		IF(RSN.NE.SNMTR)GO TO 6
33300	1801	RA=RN(J+5)*100.+RN(J+6)
33400	C  THE TIME SIG.
33500		IF(XMTR.EQ.RA)GO TO 6
33600		XMTR=RA
33700		YMTR=0
33800		GO TO 1800
33900	81	IF(RSN.NE.SN)GO TO 6
34000	1800	IF(RN(J+3).LT.XLFT)GO TO 6
34100	C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
34200		IF(R.NE.5)GO TO 810
34300	C NEXT CHECKS FOR SLUR OVER END OF LINE
34400		IF(RN(J+6).GE.199.)RN(J+6)=200.
34500	C  ****** 200.0 ABOVE IS SUBJECT TO CHANGE!
34600	810	CALL PNRN(J,IWDS,K)
34700	CC810	JA=PWDS(K+1)
34800	CC	RN(J+2)=RS
34900	CC	DO 7 KY=J,JA-1
35000	CC	PN(LK)=RN(KY)
35100	CC7	LK=LK+1
35200	CC	IF(R5)GO TO 6666
35300	CC	IF(PN(J).EQ.2)LK=LK+1
35400	CC	PN(J)=3
35500	CC	PN(J+5)=R5
35600	CC6666	L=L+1
35700	CC	XWDS(L)=LK
35800	6	CONTINUE
35900	
36000	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
36100	CC	I=1
36200	CC	DO 243 K=1,L-1
36300	CC	LB=XWDS(K)+1
36400	CC	IF(PN(LB).NE.16)GO TO 243
36500	CC	IF(PN(LB-1).LT.8)GO TO 243
36600	CC	JL=XWDS(K-1)
36700	CC244	PN(LB+2)=PN(JL+3)
36800	C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
36900	C  FOR SPACING PROBLEMS BELOW.
37000	CC243	CONTINUE
37100	CC	M=2
37200	CC	J=1
37300	CC24	RA=100000.
37400	C  POSITION
37500	CC	DO 21 K=1,L-1
37600	CC	JL=XWDS(K)+3
37700	CC	R=PN(JL)
37800	CC	IF(R.EQ.100000)GO TO 21
37900	CC241	IF(ABS(R-RA).GT..1)GO TO 240
38000	CC	R=RA
38100	CC	PN(JL)=R
38200	C  PUT IN HERE MULTI-VOICE TRAP
38300	CC	GO TO 21
38400	CC240	IF(R.GT.RA)GO TO 21
38500	C  LINES THEM UP
38600	CC	I=K
38700	CC	RA=R
38800	CC21	CONTINUE
38900	CC	IF(RA.EQ.100000)GO TO 23
39000	C  JUMP IF ALL SORTED
39100	CC242	JL=XWDS(I)
39200	CC	LA=JL
39300	CC	N=PN(JL)+3
39400	C  NEXT POINTER
39500	CC	PWDS(M)=PWDS(M-1)+N
39600	CC	M=M+1
39700	CC	DO 22 K=J,J+N-1
39800	CC	RN(K)=PN(JL)
39900	CC22	JL=JL+1
40000	CC	PN(LA+3)=100000
40100	C  PUT IT ASIDE
40200	CC	J=N+J
40300	CC	GO TO 24
40400		CALL SORT(IWDS)
40500	
40600	23	LL=0
40700	C  TO 'MOVE' INSTEAD OF 'JUSTIFY'
40800		IF(ENDLN.EQ.0)GO TO 2334
40900		R4=0
41000		R5=1000
41100		R7=0
41200		RS=0
41300		R8=ENDLN
41400		R9=0
41500		GO TO 33
41600	2334	R4=0
41700		R5=10000
41800	CC	R8=-XLFT
41900		R8=1.-RN(4)
42000		R9=0
42100	C  INSERT??  →→ IF(R8.GT.0)R9=200.
42200		R7=0
42300		RS=0
42400	33	CALL PTMOVE(RN,PWDS)
42500	CC	DO 32 K=1,IFIX(PWDS(L))-1
42600	CC	KQ=KQ+1
42700	CC32	Q(KQ)=RN(K)
42800		CALL SHFT0(KQ)
42900	CC	L=1
43000	CC	LK=1
43100		ENDLN=ENDLN+200-XLFT
43200		TYPE 3001,KQ
43300		GO TO 10
43400	
43500	27	FORMAT(' RESPACING')
43600	CC20	K=1
43700	20	TYPE 27
43800	CC	KK=1
43900	CC220	JJ=Q(K)+3
44000	CC	PN(KK)=K
44100	C NEW POINTER
44200	CC	K=K+JJ
44300	CC	KK=KK+1
44400	CC	IF(K.LT.KQ)GO TO 220
44500	CC	PN(KK)=K
44600		CALL SHFT1(KQ)
44700	CC	L=KK
44800		KK=L
44900		TYPE 3001,L
45000	C  DELETES EXTRA BAR LINES, ETC.
45100		CALL RESTS
45200	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
45300	CC	K=1
45400	CC	L=1
45500	CC	LL=0
45600	CC	LK=1
45700	CC221	IF(Q(IFIX(PN(K))+1))GO TO 321
45800	CC	DO 421	 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
45900	CC	LL=LL+1
46000	CC421	Q(LL)=Q(KL)
46100	CC	LK=LK+1
46200	CC	PN(LK)=LL+1
46300	CC321	K=K+1
46400	CC	IF(K.LT.KK)GO TO 221
46500	CC	L=LK-1
46600		CALL SHIFT
46700	C  L=NUMBER OF ITEMS FOR RHY RECONS.
46800		N=0
46900		S=0
47000		DO 601 K=1,L
47100		J=KPN(K)
47200		N=N+1
47300		MM(N)=J+3
47400	C POS PTR.
47500		R=Q(J+1)
47600		IF(R.GT.4)GO TO 602
47700		IF(R.NE.1)GO TO 2601
47800		IF(Q(J).LT.7)GO TO 2601
47900		IF(Q(J+9))GO TO 602
48000	C  JUMP IF R9=-1, AN IGNORED NOTE (NO LEDGER LINES)
48100	2601	IF(R.NE.4)GO TO 3601
48200		LA=K+1
48300	4601	M=KPN(LA)
48400		P=Q(M+1)
48500		IF(P.LT.4)GO TO 3601
48600		IF(P.EQ.4)GO TO 601
48700	C GO ON IF NEXT AFTER BAR IS NOTE, REST, CLEF, KSIG, METER
48800		IF(P.EQ.17)GO TO 3601
48900		IF(P.EQ.18)GO TO 3601
49000		IF(LA.GE.L)GO TO 601
49100		LA=LA+1
49200		GO TO 4601
49300	3601	P=Q(J+3)
49400		IF(ABS(P-S).LE.SPCNT)GO TO 602
49500	C  SEE DATA -- SPCNT=SPACE BETWEEN NOTES.  <2.5 IS CONSIDERED 0.
49600		S=P
49700	1601	NN(N)=R
49800	C  -1= IMPORTANT ITEM FOR SPACING
49900		GO TO 601
50000	602	IF(R.EQ.17)GO TO 1601
50100		IF(R.EQ.18)GO TO 1601
50200		IF(R.NE.9)GO TO 718
50300		IF(Q(J+5).EQ.8)GO TO 1601
50400	C  FOR BAR REPEAT SIGN.
50500	718	NN(N)=0
50600		IF(R.GT.7.AND.R.LT.40)GO TO 601
50700		IF(R.LT.5)GO TO 601
50800	C  FOR DBL STPS
50900	C NEXT POS2 AND 3 OF CERTAIN ITEMS
51000		N=N+1
51100		MM(N)=J+6
51200		NN(N)=0
51300		IF(R.NE.6)GO TO 601
51400	C NEXT FOR BEAMS
51500		RZ=Q(J)
51600		IF(RZ.LT.8)GO TO 608
51700		IF(Q(J+10).LT.30)GO TO 608
51800		N=N+1
51900		MM(N)=J+8
52000		NN(N)=0
52100	608	IF(RZ.LT.7)GO TO 601
52200		IF(Q(J+7))GO TO 688
52300		IF(Q(J+8))601,689,688
52400	689	IF(RZ.LT.8)GO TO 601
52500		IF(Q(J+10).EQ.0)GO TO 601
52600	C FOUND A POS. IN P9
52700	688	IF(Q(J+9).LE.0)GO TO 601
52800		N=N+1
52900		MM(N)=J+9
53000		NN(N)=0
53100	601	CONTINUE
53200	
53300	C NEXT SORTS THE POINTS
53400	6000	J=1
53500	610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
53600		CALL EXCHG(MM(J),NN(J))
53700	C  ABOVE EXCHGS --(J) AND --(J+1)
53800		IF(J.EQ.1)GO TO 710
53900		J=J-1
54000		GO TO 610
54100	710	J=J+1
54200		IF(J.LT.N)GO TO 610
54300	C NOW ALL SORTED
54400		S2=Q(MM(1))
54500		P1=S2
54600	C  THE ABOVE 2 CAN GO BELOW 612
54700		J=1
54800	
54900	612	IF(NN(J).EQ.0)GO TO 613
55000	7102	M=J+1
55100		S1=S2
55200	616	IF(NN(M).NE.0)GO TO 614
55300		IF(M.EQ.N)GO TO 614
55400		M=M+1
55500		GO TO 616
55600	C ASSUMES PROPER END OF LIST
55700	614	K=MM(J)
55800		R=Q(K-2)
55900	C THE CODE #
56000		IF(R.NE.1)GO TO 615
56100		P=Q(K+6)
56200	
56300		IF(Q(K-3).GE.7)GO TO 629
56400	2629	TYPE 1629,(Q(LA),LA=K+1,K+6)
56500		P=1.
56600	1629	FORMAT(' NO RHYTHMIC VALUE  ',6F8.2)
56700	C WAS THERE A RHYTH VALUE
56800	629	IF(Q(K+5).EQ.1000)GO TO 630
56900		IF(Q(K-3).GE.8.AND.Q(K+7).EQ.1)GO TO 630
57000	C  GRACE NOTES R8=1000 OR R10=1
57100		IF(P.GE..25)GO TO 617
57200		DO 1600 K=J+1,N-1
57300		LA=NN(K)
57400		IF(LA.EQ.0)GO TO 1600
57500		IF(LA.GT.4)GO TO 1600
57600		IF(LA.GT.1)GO TO 617
57700	C  NEXT IS A NOTE NOW
57800		IF(AMOD(Q(MM+2),10.0).NE.0)P=.25
57900	C  ADD SPACE IF NEXT NOTE HAS ACCI AND THIS IS .LT.16TH.
58000		GO TO 617
58100	1600	CONTINUE
58200		GO TO 617
58300	615	IF(R.NE.2)GO TO 618
58400		P=Q(K+4)
58500		IF(P.LT..2)P=.2
58600	C  32ND, 64TH RESTS GET BIGGER!
58700		IF(Q(K-3).GE.5)GO TO 617
58800	C  NO VALUE WAS FOUND
58900		GO TO 2629
59000	618	IF(R.EQ.4)P=2.6
59100		IF(R.EQ.3)P=5
59200		IF(R.GE.17)P=3.
59300		IF(R.NE.9)GO TO 628
59400	C  FOR BAR REPEAT SIGN.  =HALF NOTE SPACE
59500		P=2.
59600		GO TO 617
59700	630	P=.05
59800	C  FOR GRACE NOTES
59900	617	IF(P.EQ.0)P=1
60000		IF(P.LT..125)P=.125
60100		IF(P.GT.8)P=8
60200		P=(P+(.125-P)*.7)*RSPC
60300		IF(P.GT.18)P=P-P/7
60400	C  MAKE THIS BETTER!!!!
60500	628	K=MM(M)
60600		S2=Q(K)
60700		P2=P1+P
60800		Q(K)=P2
60900		IF(M-J.EQ.1)GO TO 7103
61000	C NEXT ADJUSTS STUFF IN BETWEEN
61100		R=P/(S2-S1)
61200		DO 620 K=J+1,M-1
61300		LA=MM(K)
61400	620	Q(LA)=P1+R*(Q(LA)-S1)
61500	7103	P1=P2
61600		J=M
61700		IF(J.LT.N)GO TO 7102
61800	613	J=J+1
61900		IF(J.LT.N)GO TO 612
62000	C  ALL DONE!
62100	C***	IF(XLFT.EQ.0)GO TO 600
62200	C  NEXT MOVES LEFT SIDE OF STAFF TO ZERO
62300	CC	R5=10000.
62400	CC	R7=RS
62500	CC	R8=-XLFT
62600	CC	R4=-101
62700	CC	R9=0
62800	CC	CALL PTMOVE(Q,PN)
62900	CC	J=1
63000	CC	CALL OFILE(1,'PX')
63100	CC	LL=PN(L+1)
63200	CC2929	WRITE(1),L,LL,
63300	CC	1(PN(K),K=1,L+1),(Q(K),K=1,LL-1),NAMX,STFSZ,J,J,RSTFAC,STFF,IV,STFF
63400		CALL PUTFIL('PARTS')
63500	2929	JJ2=L+2
63600		JPQ=KPN(L+1)+1
63700		CALL FASTOU(RSTFAC,128)
63800		CALL FASTOU(PN,JJ2)
63900		CALL FASTOU(Q,JPQ)
64000		CALL FINFIL
64100		CALL PT2(PN,Q,PWDS,RN)
64200	2	FORMAT(A5,30I)
64300	3001	FORMAT(2I6)
64400	5	FORMAT(5F)
64500		END